home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok53 / oberon2.0 / demos / sparks.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  127 lines
  1. MODULE Sparks;
  2.  
  3. IMPORT g:   Graphics,
  4.        I:   Intuition,
  5.        sys: SYSTEM;
  6.  
  7. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  8.  
  9. CONST
  10.   maxLines = 64;
  11.   erase = 0;
  12.   draw = 1;
  13.   x = 0;
  14.   y = 1;
  15.   start = 0;
  16.   end   = 1;
  17.  
  18. TYPE
  19.   point = ARRAY 2 OF INTEGER; (* x,y *)
  20.   line  = ARRAY 2 OF point;   (* start,end *)
  21.  
  22. VAR
  23.   i: INTEGER;
  24.   ns: I.NewScreen;
  25.   screen: I.ScreenPtr;
  26.   Ciapra[0BFE001H]: SHORTSET;
  27.   lines: ARRAY maxLines OF line;
  28.   l: line;
  29.   cl: INTEGER;
  30.   color: INTEGER;
  31.   deltas: line;
  32.   w,h: INTEGER;
  33.  
  34.   cols: ARRAY 2 OF INTEGER;
  35.  
  36. TYPE
  37.   ColArr = ARRAY 6*15 OF INTEGER;
  38.  
  39. CONST
  40.   colors = ColArr(0F00H,0F10H,0F20H,0F30H,0F40H,0F50H,0F60H,0F70H,0F80H,0F90H,0FA0H,0FB0H,0FC0H,0FD0H,0FE0H,
  41.                   0FF0H,0EF0H,0DF0H,0CF0H,0BF0H,0AF0H,09F0H,08F0H,07F0H,06F0H,05F0H,04F0H,03F0H,02F0H,01F0H,
  42.                   00F0H,00F1H,00F2H,00F3H,00F4H,00F5H,00F6H,00F7H,00F8H,00F9H,00FAH,00FBH,00FCH,00FDH,00FEH,
  43.                   00FFH,00EFH,00DFH,00CFH,00BFH,00AFH,009FH,008FH,007FH,006FH,005FH,004FH,003FH,002FH,001FH,
  44.                   000FH,010FH,020FH,030FH,040FH,050FH,060FH,070FH,080FH,090FH,0A0FH,0B0FH,0C0FH,0D0FH,0E0FH,
  45.                   0F0FH,0F0EH,0F0DH,0F0CH,0F0BH,0F0AH,0F09H,0F08H,0F07H,0F06H,0F05H,0F04H,0F03H,0F20H,0F01H);
  46.  
  47.  
  48. PROCEDURE DrawLine(l: line; color: INTEGER);
  49.  
  50. VAR rp: g.RastPortPtr;
  51.  
  52. BEGIN
  53.   rp := sys.ADR(screen.rastPort);
  54.   g.SetDrMd(rp,g.jam1);
  55.   g.SetAPen(rp,color);
  56.   g.Move(rp,  l[start,x],  l[start,y]);
  57.   g.Draw(rp,  l[end,  x],  l[end,  y]);
  58.   g.Draw(rp,w-l[start,x],h-l[start,y]);
  59.   g.Draw(rp,w-l[end,  x],h-l[end,  y]);
  60.   g.Draw(rp,  l[start,x],  l[start,y]);
  61. END DrawLine;
  62.  
  63.  
  64. PROCEDURE Adjust(VAR c,dc: INTEGER; max: INTEGER);
  65.  
  66. VAR
  67.   i: INTEGER;
  68.   VHPosR[0DFF006H]: SET;
  69.  
  70. BEGIN
  71.   i := dc - 8;
  72.   INC(c,i);
  73.   IF (c<0) OR (c>max) THEN
  74.     DEC(c,i);
  75.     i := sys.VAL(INTEGER,VHPosR*{0..3});
  76.     IF i>7 THEN INC(i,1) END;
  77.     dc := i;
  78.   END;
  79. END Adjust;
  80.  
  81.  
  82.  
  83. BEGIN
  84.  
  85.   ns.width  := g.gfx.normalDisplayColumns;
  86.   ns.height := -1;
  87.   ns.depth  := 1;
  88.   ns.type   := I.customScreen+{I.screenQuiet};
  89.   ns.viewModes := {g.lace,g.hires};
  90.   screen := I.OpenScreen(ns);
  91.  
  92.   IF screen#NIL THEN
  93.  
  94.     w := screen.width-1;
  95.     h := screen.height-1;
  96.  
  97.     REPEAT
  98.  
  99.       cols[1] := colors[color DIV 16];
  100.       INC(color); IF color=1440 THEN color := 0 END;
  101.  
  102.       g.LoadRGB4(sys.ADR(screen.viewPort),cols,2);
  103.  
  104.       DrawLine(lines[cl],erase);
  105.  
  106.       i := start;
  107.       REPEAT
  108.         Adjust(l[i,x],deltas[i,x],w);
  109.         Adjust(l[i,y],deltas[i,y],h);
  110.         INC(i);
  111.       UNTIL i>end;
  112.  
  113.       DrawLine(l,draw);
  114.       lines[cl] := l;
  115.  
  116.       INC(cl);
  117.       IF cl=maxLines THEN cl := 0 END;
  118.  
  119.     UNTIL NOT(6 IN Ciapra);
  120.  
  121.     I.OldCloseScreen(screen);
  122.  
  123.   END
  124.  
  125. END Sparks.
  126.  
  127.